﻿////////////////////////////////////////////////////////////
//  Модуль основных определений (реализация)
//  Василий Кудрявцев
//  8 июня 2008 года
//
#light

namespace Fp

module FpCore

open System.Collections.Generic

open Printf



(* ----------------------- abstract grammar  ----------------------------- *)
type num = bignum

type public fct =
    Prim of string
  | Sel of int
  | RSel of int
  | User of string
  | ApplyToAll of fct
  | Insert of fct
  | Construction of fct list
  | Composition of fct * fct
  | Condition of fct * fct * fct
  | Constant of expr
  | Bu of fct * expr
  | While of fct * fct
and expr =
    Bottom
  | Void
  | T
  | F
  | Var of string
  | Int of num
  | Seq of expr list
  | App of fct * expr
  ;;
type cmd =
    Def of string * fct
  | Undef of string
  | Show of string
  | Exp of expr
  ;;

(* ------------------------------- printers ---------------------------- *)


let rec string_of_fct2 f bc = match f with
  (* bc means put braces around composition *)
  | Prim s -> s
  | Sel n  -> ( n.ToString()) ^ "s"
  | RSel n -> ( n.ToString()) ^ "r"
  | User s -> s

  | Insert     fct -> sprintf "/%s" (string_of_fct2 fct true)
  | ApplyToAll fct -> sprintf "@%s" (string_of_fct2 fct true)
  | Construction l -> 
      (List.fold_left (fun s f -> s ^ (if s="[ " then "" else ", ") ^ (string_of_fct f)) "[ " l) ^ " ]"
  | Composition (f1,f2) ->
   (if bc then "( " else "") ^
   (string_of_fct f1) ^ " o " ^ (string_of_fct f2) ^ 
   (if bc then " )" else "")
  | Condition(p,f,g) -> (string_of_fct p) ^ " -> " ^ (string_of_fct f) ^ " ; " ^ (string_of_fct g)
  | Constant e -> "~" ^ (string_of_expr e)
  | Bu(f,e) -> "bu " ^ (string_of_fct2 f true) ^ " " ^ (string_of_expr e)
  | While(p,f) -> sprintf "while %s %s" (string_of_fct2 p true) (string_of_fct2 f true)

and string_of_expr = function
  | T   -> "T" | F   -> "F" | Bottom -> "."
  | Int n  ->  (num.ToInt32 n).ToString() 
  | Var   v  -> v
  | Seq(l) -> 
      (List.fold_left (fun s e -> s ^ 
                                   (if s="< " then "" else", ") ^ (string_of_expr e)) "< " l) ^">" 
  | App(fct,e)    -> (string_of_fct fct) ^  ":" ^ (string_of_expr e)
and
    string_of_fct f = string_of_fct2 f false;;




(* ---------------------------- user definitions ----------------------- *)

let public defs = new Dictionary<string, fct>(50); (* table of defs *)

let public add_user_def name fctn = if defs.ContainsKey(name) then                                   
                                        defs.Remove(name) |> ignore;                                        
                                        defs.Add(name, fctn);
                                        false
                                        else
                                        defs.Add(name, fctn);
                                        true
                                                              
let public get_user_def name     =  defs.[name]
let public del_user_def name     =  defs.Remove(name) |> ignore



exception Eval_bottom of expr       (* bad arguments        *)
exception Eval_error of expr        (* unknown function     *)
exception Eval_bug of string        (* should never happen! *)

;;


